home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / lisp211.arc / PC-LISP.L < prev    next >
Encoding:
Text File  |  1986-05-15  |  6.8 KB  |  160 lines
  1. ;; PC-LISP.L  for PC-LISP.EXE V2.11                                
  2. ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~                                                     
  3. ;;     A small library of functions to help fill in the gap between PC and      
  4. ;; Franz Lisp. These functions are not documented in the LISP.DOC file but 
  5. ;; any Franz manual will cover them in detail. Especially the backquote 
  6. ;; and other macro definitions towards the end of the file. These functions
  7. ;; were written pretty hastily so there could be bugs. Check them out for
  8. ;; yourself to make sure they behave in the way you are used to with Franz.
  9. ;;
  10. ;;    This file is automatically loaded by PC-LISP.EXE. It should either    
  11. ;; be located in the current working directory, or in a library directory
  12. ;; whose path is set in the LISP%LIB environment variable. All load files
  13. ;; should be put in your LISP%LIB directory. You should also strip out the 
  14. ;; comments and white space from this file to make it load faster. This
  15. ;; is important if you load this file every time you run PC-LISP.
  16. ;;      
  17. ;;              Peter Ashwood-Smith
  18. ;;                May 1986
  19. ;;
  20. ;; Pretty Print: (pp [(F file) (E expr) (P port)] symbol)
  21. ;; ~~~~~~~~~~~~
  22. ;;    Print in a readable way the function associated with 'symbol'. If
  23. ;; the parameter (F file) is specified the output goes to file 'file. If
  24. ;; the parameter (P port) is specified the output goes to the open port
  25. ;; 'port'. If the parameter (E expr) is specified the expression 'expr'
  26. ;; is evaluated before the function is pretty printed. Makes use of the
  27. ;; predefined symbol poport whose binding is 'stdout'.
  28.  
  29. (defun pp fexpr(l)
  30.        (prog (expr name port alt)
  31.          (setq port poport)
  32.          (cond ((= (length l) 1) (setq name (car l)))
  33.            ((= (length l) 2) (setq name (cadr l) alt (car l)))
  34.            (t (return nil))
  35.          )
  36.          (cond ((null (getd name)) (return nil)))
  37.          (setq expr (cons 'def (cons name (list (getd name)))))
  38.          (cond ((null alt) (go SKIP)))   
  39.          (cond ((eq (car alt) 'F) (setq port (fileopen (cadr alt) 'w)))
  40.            ((eq (car alt) 'P) (setq port (cadr alt)))
  41.            ((eq (car alt) 'E) (eval (cadr alt)))
  42.            (t (return nil)))
  43.          (cond ((null port) (patom "cannot open port\n") (return nil)))
  44.        SKIP  (pp-form expr port 0)
  45.          (cond ((not (equal port poport)) (close port)))
  46.          (return t)
  47.        )
  48. )
  49.     
  50. ;; ----------- ASSORTED PREDICATES ETC ------------
  51.  
  52. (defun tailp(l1 l2)(cond ((null l2) nil)((eq l1 l2) l1)(t(tailp l1(cdr l2]  
  53. (defun arrayp(x) nil)           
  54. (defun bcdp(x) nil)             
  55. (defun bigp(x) nil)             
  56. (defun dtpr(x) (and (listp x) (not (null x))))  
  57. (defun consp(x) (and (listp x) (not (null x))))
  58. (defun litatom(n) (and(atom n)(not(floatp n]   
  59. (defun purep(n)(or(eq n t)(eq n nil)(eq n 'lambda)(eq n 'nlambda)(eq n 'macro]
  60. (defun symbolp(n) (litatom n))                  
  61. (defun valuep(n) nil)
  62. (defun vectorp(n) nil)
  63. (defun typep(n)(type n))
  64. (defun eqstr(a b)(equal a b))
  65. (defun neq(a b)(not(eq a b)))
  66. (defun nequal(a b)(not(equal a b)))
  67. (defun append1(a b)(append a (list b)))
  68. (defun ncons(a)(cons a nil))
  69. (defun xcons(a b)(cons b a))
  70. (defun nthelem(n l) (nth (- n 1) l))
  71. (defun minus(n)(- 0 n))
  72. (defun onep(n)(= 1 n))
  73. (defun infile(f)(fileopen f 'r)) 
  74. (defun terpri macro(l)                      ; builds (princ "\n" [port])
  75.       (append (list 'princ "\n")(cdr l)))
  76.  
  77. ;; BACKQUOTE READ MACRO AND PARTS  
  78. ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  79. ;;      This  file  describes  the back quote macro for PC-LISP. It works in
  80. ;; exactly the same way as the  FRANZ  backquote  macro works. Basically the
  81. ;; backquote macro ` is supposed to  work  together  with the comma , and at
  82. ;; @ macros. As follows: Backquote  has the same effect as ' except that any
  83. ;; elements or  sub  elements  that  are preceeded by , are evaluated. If an
  84. ;; element  is  preceeded  by  ,@  then  the element is evaluated and should 
  85. ;; evaluate to  a  list.  This  list  is  spliced into the built list. I use 
  86. ;; cons  to  do  list  building  and append to do list splicing. For example
  87. ;; the  input:  `(a ,b c)  will  be  read in  as  (a (*unquote* b) c) by the
  88. ;; back quote read macro because the  comma  macro  will have read the b and
  89. ;; built up the list (*unquote* b). Next the back quote macro passes control
  90. ;; to the _BQB_ function (Back Quote  Builder). This will construct the list
  91. ;; (cons 'a (cons b (cons 'c nil)))  which  when evaluated gives the desired    
  92. ;; result. If the , were  followed  by  an @ then the @ would build the form
  93. ;; (*splice* b). Then the  , would get this form and the function _CB_ comma
  94. ;; builder would then make  then pass the form unchanged. Next the backquote
  95. ;; builder  _BQB_  would  get the form (a (*splice* b) c) and build the form
  96. ;; (cons 'a (append b (cons 'c nil)))  which will cause the value of b to be
  97. ;; spliced into the list rather than forming a sublist element as desired.
  98.  
  99. (defun _BQB_(Sexp) 
  100.        (cond ((null Sexp) Sexp)
  101.          ((atom Sexp) (list 'quote Sexp))
  102.          ((eq (car Sexp) '*unquote*)
  103.           (cadr Sexp))
  104.          ((and(listp (car Sexp)) (eq (caar Sexp) '*splice*))
  105.           (list 'append (cadar Sexp)
  106.                  (_BQB_ (cdr Sexp))))
  107.          ( t (list 'cons (_BQB_ (car Sexp))
  108.                  (_BQB_ (cdr Sexp))))
  109.        )
  110. )
  111.  
  112. (defun _CB_(Sexp)
  113.        (cond ((null Sexp) Sexp)
  114.          ((atom Sexp) (list '*unquote* Sexp))
  115.          (t Sexp)
  116.        )    
  117. ) 
  118.           
  119. (setsyntax '|`| 'vmacro '(lambda()(_BQB_ (read))))
  120. (setsyntax '|,| 'vmacro '(lambda()(_CB_ (read))))
  121. (setsyntax '|@| 'vmacro '(lambda()(list '*splice* (read))))
  122.  
  123.  
  124. ;; macro  : (let ((p1 v1)(p2 v2)...(pn vn)) e1 e2 ... en)
  125. ;; ~~~~~  
  126. ;;      Let macro introduces local variables. Much used in Franz code it
  127. ;; basically creates a lambda expression of the form:
  128. ;;
  129. ;;          ((lambda(p1 p2 ... pn) e1 e2 ... en) v1 v2 ...vn)
  130. ;;
  131.  
  132. (defun let macro(x)
  133.        (cons (append (cons 'lambda                       ; ((lambda ..rest..
  134.             (list (mapcar 'car (cadr x))))   ; ((p1 p2...pn))
  135.              (cddr x))                           ; (e1 e1...en)
  136.          (mapcar 'cadr (cadr x))                     ; (v1 v2...vn)
  137.        )
  138. )
  139.  
  140. ;; macro defmacro
  141. ;; ~~~~~~~~~~~~~~
  142. ;;    Like defun except that it declares a macro. This is more convenient
  143. ;; than using the defun name macro(l) because access to variables can be
  144. ;; named. It produces almost he same intermediate form as Franz except that
  145. ;; it uses the (nth N xxx) form rather than the (cadddr xxx) form for access
  146. ;; to the macro parameters.     
  147. ;;
  148.  
  149. (defun defmacro fexpr(plist) 
  150.   (putd (car plist)
  151.     (cons 'macro
  152.        (list '(defmacroarg)
  153.           (cons (cons 'lambda (cdr plist))
  154.             (prog (n res)
  155.                   (setq n (length (cadr plist))) 
  156.              DML: (cond ((zerop n) (return res)))
  157.                   (setq res `((nth ,n defmacroarg) ,@res) n (1- n))
  158.                   (go DML:)))))))
  159.  
  160.